Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/vbpcopy/jmdrive.bas

BASIC Source File | 1998-10-06 | 5KB | 140 lines

Attribute VB_Name = "JMDriveSubs"
Option Explicit

Public Function JMTestCanWrite(argProgramName, argPath As String, argSize As Long, argError As String) As Integer
    JMTestCanWrite = False
    On Error Resume Next
    If (JMTestDriveRemoveable(argPath) = False) Then
        If (JMTestDriveIsReady(argPath) = False) Then
            argError = "Drive is Not Ready."
            Exit Function
        End If
        If (argSize >= (JMTestDriveAvailableSpace(argPath) - 1024)) Then
            argError = "Not enough space on Drive."
            Exit Function
        End If
        JMTestCanWrite = True
        Exit Function
    Else
        Do
            If (JMTestDriveIsReady(argPath) = False) Then
                Select Case MsgBox("Drive is Not Ready." & vbCrLf & vbCrLf & "Do you want to Continue?", vbDefaultButton2 + vbYesNo + vbQuestion, argProgramName)
                Case vbYes
                Case Else
                    argError = ""
                    Exit Function
                End Select
            End If
            If (argSize >= (JMTestDriveAvailableSpace(argPath) - 1024)) Then
                Select Case MsgBox("Not enough space on Drive - Change to a New Disc." & vbCrLf & vbCrLf & "Do you want to Continue?", vbDefaultButton2 + vbYesNo + vbQuestion, argProgramName)
                Case vbYes
                Case Else
                    argError = ""
                    Exit Function
                End Select
            Else
                JMTestCanWrite = True
                Exit Function
            End If
        Loop
    End If
End Function

Public Function JMTestDriveAvailableSpace(argPath As String) As Long
    Dim wrkFileObject As Object
    Dim wrkDrives
    Dim wrkDrive As Object
    JMTestDriveAvailableSpace = 0
    On Error Resume Next
    Set wrkFileObject = CreateObject("Scripting.FileSystemObject")
    Set wrkDrives = wrkFileObject.Drives
    For Each wrkDrive In wrkDrives
        If (StrComp(wrkDrive.DriveLetter, Left$(argPath, 1), 1) = 0) Then
            If (wrkDrive.IsReady = False) Then Exit For
            JMTestDriveAvailableSpace = wrkDrive.AvailableSpace
            Exit For
        End If
    Next wrkDrive
    Exit Function
End Function

Public Function JMTestDriveIsReady(argPath As String) As Integer
    Dim wrkFileObject As Object
    Dim wrkDrives
    Dim wrkDrive As Object
    JMTestDriveIsReady = False
    On Error Resume Next
    Set wrkFileObject = CreateObject("Scripting.FileSystemObject")
    Set wrkDrives = wrkFileObject.Drives
    For Each wrkDrive In wrkDrives
        If (StrComp(wrkDrive.DriveLetter, Left$(argPath, 1), 1) = 0) Then
            If (wrkDrive.IsReady = True) Then JMTestDriveIsReady = True
            Exit For
        End If
    Next wrkDrive
    Exit Function
End Function

Public Function JMTestDriveRemoveable(argPath As String) As Integer
    Dim wrkFileObject As Object
    Dim wrkDrives
    Dim wrkDrive As Object
    JMTestDriveRemoveable = False
    On Error Resume Next
    Set wrkFileObject = CreateObject("Scripting.FileSystemObject")
    Set wrkDrives = wrkFileObject.Drives
    For Each wrkDrive In wrkDrives
        If (StrComp(wrkDrive.DriveLetter, Left$(argPath, 1), 1) = 0) Then
            Select Case wrkDrive.DriveType
            Case 1
                JMTestDriveRemoveable = True
            End Select
            Exit For
        End If
    Next wrkDrive
    Exit Function
End Function

Public Function JMTestDriveWrite(argPath As String, argError As String) As Integer
    Dim wrkFileObject As Object
    Dim wrkDrives
    Dim wrkDrive As Object
    Dim wrkString As String
    Dim wrkDriveLetter As String
    JMTestDriveWrite = False
    On Error Resume Next
    Set wrkFileObject = CreateObject("Scripting.FileSystemObject")
    Set wrkDrives = wrkFileObject.Drives
    wrkDriveLetter = Left$(argPath, 1)
    For Each wrkDrive In wrkDrives
        If (StrComp(wrkDrive.DriveLetter, wrkDriveLetter, 1) = 0) Then
            wrkString = wrkDrive.DriveLetter & " - "
            Select Case wrkDrive.DriveType
            Case 1, 2, 3
                JMTestDriveWrite = True
            Case 4
                argError = "Can't Write to CD-ROM [" & wrkDriveLetter & ":]."
            Case 5
                argError = "Can't Write to RAM Disk [" & wrkDriveLetter & ":]."
            Case Else
                argError = "Can't Write to Drive [" & wrkDriveLetter & ":]."
            End Select
            Exit For
        End If
    Next wrkDrive
    Exit Function
End Function

Public Function JMCreateFolder(argPath As String, argError As String) As Integer
    Dim wrkFileObject As Object
    JMCreateFolder = False
    On Error GoTo JMCreateFolderError
    Set wrkFileObject = CreateObject("Scripting.FileSystemObject")
    wrkFileObject.CreateFolder (argPath)
    JMCreateFolder = True
    Exit Function
JMCreateFolderError:
    argError = Error()
    Exit Function
End Function